unit Analyser;

{
  PasCalc
  Version 1.2 2011-05-26

  Copyright (C) 2011 KEEPER <yar.keeper@gmail.com>

  This file is part of the PasCalc Calculator

  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  See the file LICENSE.TXT, included in this distribution,
  for details about the copyright.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}

interface

uses
  Math, ComplexOps, SysUtils, Classes, Dialogs;

type

  KOLString = ANSIString;

{ Support Types Declaration }
{------------------------------------------------------------------------------}
  TLexType = (ltNum, ltVar, ltId, ltSep, ltLBr, ltRBr, ltASep,
    ltOp1, ltOp2, ltUnOp, ltNone);

  TReasons = (errNone, errEnd, errIdent, errIllegal, errBracket, errExpr, errAryphm,
    errDivZero, errNoInt);

  TComplexArr = array of TComplex;

  TComplexMatrix = array of TComplexArr;

  TVar = record
    fName: char;
    fCount: integer;
  end;

  type TFloatMatrix = array of array of extended;

  TLexeme = record
    LexType: TLexType;
    StartPos, EndPos: integer;
    case integer of
      0: (D: TComplex);
      1: (C: Char);
      2: (S: ShortString);
      3: (V: TVar);
  end;

  TVector = array of extended;

  TLexemeArray = array of Tlexeme;

  TVarArr = array of TVar;

  TErr = record
    Reason: TReasons;
    Pos: integer;
  end;

{ Classes Declaration }
{------------------------------------------------------------------------------}

{ TLexAnalyser }

  TLexAnalyser = class
  private
    fVarArray: TVarArr;
    fStr: KOLString;
    fResult: TLexemeArray;
    fPos: integer;
    fVarCount: integer;
    fIsExpMode: boolean;
    function IsDigit: boolean;
    function IsExp: boolean;
    function IsSign: Boolean;
    function Number(var Error: TErr): TComplex;
    function ExpAbs(var Error: TErr): extended;
    function ExpArg(var Error: TErr): extended;
    function ExpFindExtended(var error: TErr): extended;
    function ExpNumber(var Error: TErr): TComplex;
    function FindIm: boolean;
    function Ident(var Error: TErr): ShortString;
    procedure Correct;
    function RBracketCheck(Pos: integer): TErr;
    procedure SetIsExpMode(const AValue: boolean);
    function UnOpFind: boolean;
    function AddVar(const Name: char): TVar;
    function FindExtended(var Error: TErr): Extended;
    function ExpIsImExists: boolean;
  public
    IsRad: boolean;
    constructor Create(const Source: KOLString);
    function Analyse(var seq: TLexemeArray): TErr;
    property IsExpMode: boolean read fIsExpMode write SetIsExpMode;
  end;

  { TSyntaxAnalyser }

  TSyntaxAnalyser = class
  private
    fSeq: TLexemeArray;
    fPos: integer;
    fVarArray: TComplexArr;
    fIsRad: boolean;
    Lexeme: TLexeme;
    function Expr(var Error: TErr): TComplex;
    procedure SetVar(const AValue: TComplexArr);
    function Term(var Error: TErr): TComplex;
    function Factor(var Error: TErr): TComplex;
    function IdCalc(var Error: TErr): TComplex;
    procedure SeIsRadians(const Value: boolean);
  public
    constructor Create(Source: TLexemeArray);
    function calc(var Error: TErr): TComplex;
    property Variable: TComplexArr read fVarArray write SetVar;
    property IsRadians: boolean read fIsRad write SeIsRadians;
    destructor Destroy; override;
  end;

  { TCalculator }

  TCalculator = class
  private
    fLexSeq: TLexemeArray;
    fLexAn: TLexAnalyser;
    fSynAn: TSyntaxAnalyser;
    fStr: KOLString;
    fIsRad: boolean;
    fIsExpMode: Boolean;
    fIsLog: boolean;
    fLogFileName: KOLString;
    Error: TErr;
    procedure SetIsExpMode(const AValue: boolean);
    procedure SetIsLog(const AValue: boolean);
    procedure SetIsRad(const AValue: boolean);
    procedure SetLogFileName(const AValue: KOLString);
    procedure FormLog(Strings: TStringList);
  public
    ErrorHappens: boolean;
    constructor Create(const Str: KOLString);
    property IsRad: boolean read fIsRad write SetIsRad;
    property IsExp: boolean read fIsExpMode write SetIsExpMode;
    procedure OnlyAnalyse;
    function CalcWithoutVars: TComplex;
    function SingleVarCalc(const Variable: TComplex): TComplex;
    function SingleVarIteration(const From: extended; const ToDo: extended;
      const Step: extended): TComplexMatrix;
    function FormGraphMatrix(const From: extended; const ToDo: extended;
      const Step: extended; const Constraint: extended): TFloatMatrix;
    function MultiVarCalc(const VarArray: TComplexArr): TComplex;
    function GetValuesFromArguments(const Arguments: TVector): TVector;
    function GetLastError: KOLString;
    property IsLog: boolean read fIsLog write SetIsLog;
    property LogFileName: KOLString read FLogFileName write SetLogFileName;
  end;

implementation


{ TLexAnalyser }

constructor TLexAnalyser.Create(const Source: KOLString);
begin
  fStr := Source;
  correct;
  fVarCount := -1;
  fVarArray := nil;
end;

function TLexAnalyser.FindExtended(var Error: TErr): Extended;
var
  pos: integer;
  teststr: kolstring;
begin
  Result := 0;
  Error.Reason := errNone;
  pos := fPos;
  if (fStr[fPos] = '+') then
  begin
    if fPos < length(fStr) then
    begin
      inc(fPos);
      result := FindExtended(error);
    end else Error.Reason := errEnd;
    exit;
  end;
  if (fStr[fPos] = '-') then
  begin
    if fPos < Length(fStr) then
    begin
      inc(fPos);
      result := -FindExtended(error);
    end else Error.Reason := errEnd;
    exit;
  end;
  repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  if (fPos > length(fStr)) then
  begin
    result := StrToFloat(Copy(fStr, pos, fPos - pos));
    exit;
  end;
  if fStr[fPos] = DecimalSeparator then
  begin
    inc(fPos);
    if (fPos > length(fStr)) or (not IsDigit) then
    begin
      Error.Reason := errEnd;
      Error.Pos := fPos;
      exit;
    end;
    repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
    if (fPos > length(fStr)) or not IsExp then
    begin
      result := StrToFloat(Copy(fStr, pos, fPos - pos));
      exit;
    end;
  end;
  if not IsExp then
  begin
    teststr := Copy(fStr, pos, fPos - pos);
    result := StrToFloat(teststr);
    exit;
  end;
  inc(fPos);
  if IsSign then inc(fPos);
  if (fPos > length(fStr)) or (not IsDigit) then
  begin
    Error.Reason := errIllegal;
    Error.Pos := fPos;
    exit;
 end;
 repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
 result := StrToFloat(Copy(fStr, pos, fPos - pos));
end;

function TLexAnalyser.ExpIsImExists: boolean;
const
  AgrSymb = ['0'..'9', '+', '-', ',', '.'];
var
  pos: integer;
begin
  result := false;
  pos := fPos;
  inc(fPos);
  if IsSign then inc(fPos);
  repeat inc(fPos) until not (fStr[fPos] in AgrSymb) or (fPos > length(fStr));
  if fPos > Length(fStr) then
  begin
    fPos := pos;
    exit;
  end
  else
    if fStr[fPos] = 'i' then result := true;
  fPos := pos;
end;

function TLexAnalyser.FindIm: boolean;
var
  pos: integer;
begin
  result := false;
  pos := fPos;
  if (fStr[fPos] <> '+') and (fStr[fPos] <> '-') then
  begin
    fPos := pos;
    exit;
  end;
  repeat inc(fPos) until (fPos > length(fStr)) or (not (fStr[fPos] in ['+', '-']));
  if not IsDigit then
  begin
    fPos := pos;
    exit;
  end;
  repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  {правил}
  if fPos > Length(fStr) then
  begin
    fPos := pos;
    exit;
  end;
  if fStr[fPos] = decimalseparator then
    repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  if fStr[fPos] = 'e' then
  begin
    if (fStr[fPos+1] = '-') or (fStr[fPos+1] = '+') then inc(fPos);
    repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  end;
  if fPos > Length(fStr) then
  begin
    fPos := pos;
    exit;
  end;
  if (fStr[fPos] = 'i') then result := true;
  fPos := pos;
end;

procedure TLexAnalyser.Correct;
var i: integer;
begin
  for i := 1 to length(fStr) do
    if (fStr[i] = '.') or (fStr[i] = ',') then
      if fStr[i] <> DecimalSeparator then fStr[i] := DecimalSeparator;
end;

function TLexAnalyser.Analyse(var seq: TLexemeArray): TErr;
var
  Value: TComplex;
  StrValue: ShortString;
  ChValue: Char;
  Variable: TVar;
  Error: TErr;
  StartPos: integer;
const
  Ops1 = ['+', '-'];
  Avail = ['0'..'9', ')', 'A'..'Z', 'a'..'z'];
begin
  result.Reason := errNone;
  Error.Reason := errNone;
  fPos := 1;
  while (fPos <= Length(fStr)) do
  begin
    StartPos := fPos;
    case fStr[fPos] of
      '0'..'9':
      begin
        if fIsExpMode then Value := ExpNumber(Error) else Value := Number(Error);
        if Error.Reason <> errNone then
        begin
          Result := Error;
          exit;
        end;
        SetLength(fResult, length(fResult)+1);
        fResult[high(fResult)].LexType := ltNum;
        fResult[high(fResult)].D := Value;
        fResult[high(fResult)].StartPos := StartPos;
        fResult[high(fResult)].EndPos := fPos-1;
      end;
      '(':
      begin
        Error := RBracketCheck(fPos);
        if Error.Reason <> errNone then
        begin
          Result := Error;
          exit;
        end;
        ChValue := '(';
        SetLength(fResult, length(fResult)+1);
        fResult[high(fResult)].LexType := ltLBr;
        fResult[high(fResult)].C := ChValue;
        fResult[high(fResult)].StartPos := StartPos;
        fResult[high(fResult)].EndPos := fPos;
        inc(fPos)
      end;
      ')':
      begin
        ChValue := ')';
        SetLength(fResult, length(fResult)+1);
        fResult[high(fResult)].LexType := ltRBr;
        fResult[high(fResult)].C := ChValue;
        fResult[high(fResult)].StartPos := StartPos;
        fResult[high(fResult)].EndPos := fPos;
        inc(fPos);
      end;
      'A'..'Z', 'a'..'z':
      begin
        if not (fStr[fPos+1] in ['A'..'Z', 'a'..'z']) then
        begin
          SetLength(fResult, length(fResult)+1);
          variable := AddVar(fStr[fPos]);
          fResult[high(fResult)].LexType := ltVar;
          fResult[high(fResult)].V := Variable;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos;
          inc(fPos);
          continue;
        end;
        StrValue := Ident(Error);
        if Error.Reason <> errNone then
        begin
          Result := Error;
          exit;
        end;
        SetLength(fResult, length(fResult)+1);
        fResult[high(fResult)].LexType := ltId;
        fResult[high(fResult)].S := StrValue;
        fResult[high(fResult)].StartPos := StartPos;
        fResult[high(fResult)].EndPos := fPos-1;
      end;
      ' ':
      begin
        ChValue := fStr[fPos];
        SetLength(fResult, length(fResult)+1);
        fResult[high(fResult)].LexType := ltAsep;
        fResult[high(fResult)].C := ChValue;
        fResult[high(fResult)].StartPos := StartPos;
        fResult[high(fResult)].EndPos := fPos;
        inc(fPos);
      end;
      '+', '-':
      begin
        ChValue := fStr[fPos];
        if (fPos = Length(fStr)) then
        begin
          Result.Reason := errIllegal;
          Result.Pos := fPos;
          Exit;
        end;
        if (fPos <> 1) and (fStr[fPos-1] in avail) then
        begin
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltOP1;
          fResult[high(fResult)].C := ChValue;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos;
          inc(fPos);
          continue;
        end;
        if ((fStr[fPos+1] in ops1) or (fPos = 1) or (fStr[fPos-1] in
          ['+', '-', '('])) and (not UnOpFind) then
        begin
          if fIsExpMode then Value := ExpNumber(Error) else Value := Number(Error);
          if Error.Reason <> errNone then
          begin
            Result := Error;
            exit;
          end;
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltNum;
          fResult[high(fResult)].D := Value;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos - 1;
        end else
        begin
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltUnOp;
          fResult[high(fResult)].C := ChValue;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos;
          inc(fPos);
        end;
      end;
      '*', '/':
      begin
        ChValue := fStr[fPos];
        if (fPos = Length(fStr)) or (fStr[fPos+1] in ['*', '/']) then
        begin
          if fPos = Length(fStr) then Result.Reason := errEnd else Result.Reason := errIllegal;
          Result.Pos := fPos;
          Exit;
        end;
        if (fStr[fPos-1] in avail) and (fPos <> 1) and (fPos <> Length(fStr)) then
        begin
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltOP2;
          fResult[high(fResult)].C := ChValue;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos;
          inc(fPos);
          continue;
        end;
        if (fStr[fPos+1] in ops1) then
        begin
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltOP2;
          fResult[high(fResult)].C := ChValue;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos;
          inc(fPos);
          Value := Number(Error);
          if Error.Reason <> errNone then
          begin
            Result := Error;
            exit;
          end;
          SetLength(fResult, length(fResult)+1);
          fResult[high(fResult)].LexType := ltNum;
          fResult[high(fResult)].D := Value;
          fResult[high(fResult)].StartPos := StartPos;
          fResult[high(fResult)].EndPos := fPos - 1;
        end;
      end else
      begin
        result.Reason := errIllegal;
        result.Pos := fPos;
        break;
      end;
    end;
  end;
  Seq := fResult;
end;

function TLexAnalyser.Ident(var Error: TErr): ShortString;
var pos: integer;
begin
  Pos := fPos;
  repeat inc(fPos) until (fStr[fPos] = '(') or (fPos > Length(fStr));
  if fPos > length(fStr) then
  begin
    Error.Reason := errEnd;
    Error.Pos := fPos-1;
  end;
  result := copy(fStr, pos, fPos - pos);
end;

function TLexAnalyser.IsDigit: boolean;
begin
  result := (fStr[fPos] in ['0'..'9'])
end;

function TLexAnalyser.IsExp: boolean;
begin
  result := (fStr[fPos] = 'e') or (fStr[fPos] = 'E');
end;

function TLexAnalyser.IsSign: Boolean;
begin
  result := (fStr[fPos] = '+') or (fStr[fPos] = '-')
end;

function TLexAnalyser.AddVar(const Name: char): TVar;
var i, ID: integer;
    fLag: boolean;
begin
  ID := 0;
  flag := false;
  for i := 0 to high(fVarArray) do
    if fVarArray[i].fName = Name then
    begin
      flag := true;
      ID := fVarArray[i].fCount;
      break;
    end;
  if flag then
  begin
    result.fCount := ID;
    result.fName := Name;
    SetLength(fVarArray, length(fVarArray)+1);
    fVarArray[high(fVarArray)] := result;
    exit
  end;
  if not flag then
  begin
    inc(fVarCount);
    result.fCount := fVarCount;
    result.fName := Name;
    SetLength(fVarArray, length(fVarArray)+1);
    fVarArray[high(fVarArray)] := result;
    exit
  end;
end;

function TLexAnalyser.Number(var Error: TErr): TComplex;
var
  NumError: TErr;
  temp: Extended;
begin
  Result.im := 0;
  NumError.Reason := errNone;
  temp := FindExtended(NumError);
  if NumError.Reason <> errNone then
  begin
    Error := NumError;
    exit;
  end;
  {Правил!!!}
  if not (fPos > Length(fStr)) and (fStr[fPos] = 'i') then
  begin
    result.re := 0;
    result.im := temp;
    inc(fPos);
    exit;
  end;
  result.re := temp;
  {Правил!!!}
  if (fPos > Length(fStr)) or (not FindIm) then exit;
  Result.Im := FindExtended(NumError);
  if NumError.Reason <> errNone then
  begin
    Error := NumError;
    exit;
  end;
  inc(fPos);
end;

function TLexAnalyser.ExpAbs(var Error: TErr): extended;
begin
  Error.Reason := errNone;
  ExpAbs := ExpFindExtended(Error);
end;

function TLexAnalyser.ExpArg(var Error: TErr): extended;
begin
  inc(fPos); //пропускаем букву 'e'
  Error.Reason := errNone;
  ExpArg := ExpFindExtended(Error);
  inc(fPos); //пропускаем букву 'i'
end;

function TLexAnalyser.ExpFindExtended(var error: TErr): extended;
var
  pos: integer;
begin
  Error.Reason := errNone;
  if (fStr[fPos] = '+') then
  begin
    if fPos < length(fStr) then
    begin
      inc(fPos);
      result := ExpFindExtended(error);
    end else Error.Reason := errEnd;
    exit;
  end;
  if (fStr[fPos] = '-') then
  begin
    if fPos < Length(fStr) then
    begin
      inc(fPos);
      result := -ExpFindExtended(error);
    end else Error.Reason := errEnd;
    exit;
  end;
  pos := fPos;
  repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  if (fPos > length(fStr)) then
  begin
    result := StrToFloat(Copy(fStr, pos, fPos - pos));
    exit;
  end;
  if fStr[fPos] = DecimalSeparator then
  begin
    inc(fPos);
    if (fPos > length(fStr)) or (not IsDigit) then
    begin
      Error.Reason := errEnd;
      Error.Pos := fPos;
      exit;
    end;
    repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
    if (fPos > length(fStr)) or not IsExp then
    begin
      result := StrToFloat(Copy(fStr, pos, fPos - pos));
      exit;
    end;
  end;
  if (not IsExp) or ExpIsImExists then
  begin
    result := StrToFloat(Copy(fStr, pos, fPos - pos));
    exit;
  end;
  inc(fPos);
  if IsSign then inc(fPos);
  if (fPos > length(fStr)) or (not IsDigit) then
  begin
    Error.Reason := errIllegal;
    Error.Pos := fPos;
    exit;
  end;
  repeat inc(fPos) until (fPos > length(fStr)) or (not IsDigit);
  result := StrToFloat(Copy(fStr, pos, fPos - pos));
end;

function TLexAnalyser.ExpNumber(var Error: TErr): TComplex;
var
  Arg, Abs: Extended;
begin
  error.Reason := errNone;
  Abs := ExpAbs(Error);
  if error.Reason <> errNone then exit;
  if (fPos > length(fStr)) or (not ExpIsImExists) then Arg := 0
    else Arg := ExpArg(error);
  if error.Reason <> errNone then exit;
  if not IsRad then
  begin
    Result.re := Abs * cos(DegToRad(Arg));
    Result.im := Abs * sin(DegToRad(Arg));
    exit;
  end;
  Result.re := Abs * cos(Arg);
  Result.im := Abs * sin(Arg);
end;

function TLexAnalyser.RBracketCheck(pos: integer): TErr;
var lBrPos: integer;
begin
  result.Reason := errNone;
  LBrPos := fPos;
  repeat inc(pos) until (fStr[pos] = ')') or (pos > Length(fStr));
  if pos > Length(fStr) then
  begin
    result.Reason := errBracket;
    result.Pos := LBrPos;
  end;
end;

procedure TLexAnalyser.SetIsExpMode(const AValue: boolean);
begin
  fIsExpMode := AValue;
end;

function TLexAnalyser.UnOpFind: boolean;
var
  pos: integer;
begin
  result := true;
  pos := fPos;
  repeat inc(pos) until (fStr[pos] in ['A'..'Z', 'a'..'z', '(', '0'..'9']) or (pos > Length(fStr));
  if (pos > length(fStr)) or (fStr[pos] in ['0'..'9']) then result := false;
end;

{ TSyntaxAnalyser }

function TSyntaxAnalyser.calc(var Error: TErr): TComplex;
begin
  Error.Reason := errNone;
  fPos := 0;
  result := expr(Error);
  fPos := 0;
end;

destructor TSyntaxAnalyser.Destroy;
begin
  inherited Destroy;
end;

constructor TSyntaxAnalyser.Create(Source: TLexemeArray);
begin
  fSeq := Source;
  fIsRad := False;
end;

function TSyntaxAnalyser.Expr(var Error: TErr): TComplex;
var
  op: char;
  TermError: TErr;
begin
  TermError.Reason := errNone;
  result := term(TermError);
  if TermError.Reason <> errNone then
  begin
    Error := TermError;
    exit;
  end;
  while (fPos <= High(fSeq)) and (Lexeme.LexType = ltOp1) do
  begin
    op := Lexeme.C;
    case op of
      '+': result := Plus(result, term(TermError));
      '-': result := Minus(result, term(TermError));
    end;
  end;
  Error := TermError;
end;

procedure TSyntaxAnalyser.SetVar(const AValue: TComplexArr);
begin
  fVarArray := AValue;
end;


function TSyntaxAnalyser.Factor(var Error: TErr): TComplex;
var
  Ind: integer;
  ExprError: TErr;
  IDError: TErr;
begin
  if fPos > High(fSeq) then exit;
  ExprError.Reason := errNone;
  IDError.Reason := errNone;
  Lexeme := fSeq[fPos];
  inc(fPos);
  case Lexeme.LexType of
    ltNum:
    begin
      result := Lexeme.D;
      Lexeme := fSeq[fPos];
      inc(fPos);
    end;
    ltVar:
    begin
      ind := Lexeme.V.fCount;
      try
        result := fVarArray[ind];
      except
        Error.Reason := errExpr;
        Error.Pos := fPos;
        exit;
      end;
      Lexeme := fSeq[fPos];
      inc(fPos);
    end;
    ltLBr:
    begin
      result := Expr(ExprError);
      if ExprError.Reason <> errNone then
      begin
        Error := ExprError;
        exit;
      end;
      if fPos > High(fSeq) then exit;
      Lexeme := fSeq[fPos];
      inc(fPos);
    end;
    ltId:
    begin
      result := IdCalc(IDError);
      if IDError.Reason <> errNone then
      begin
        Error := IDError;
        exit;
      end;
      Lexeme := fSeq[fPos];
      inc(fPos);
    end;
    ltUnOp:
    begin
      case Lexeme.C of
        '+': result := Factor(Error);
        '-': result := UnMinus((Factor(Error)));
      end;
    end else
    begin
      error.Reason := errExpr;
      error.Pos := 0;
    end;
  end;
end;

function TSyntaxAnalyser.IdCalc(var Error: TErr): TComplex;
var
  FirstArg: Extended;
  ExprError: TErr;
  Arg: TComplex;
begin
  try
    result.im := 0;
    ExprError.Reason := errNone;
    if Lexeme.S = 'sin' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      Arg := Expr(ExprError);
      if Arg.im = 0 then
      begin
        if not fIsRad then result.re := sin(DegToRad(Arg.re))
        else
          result.re := sin(Arg.re);
        if ExprError.Reason <> errNone then Error := ExprError;
        exit;
      end
      else
      begin

      end;
    end;
    if Lexeme.S = 'cos' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      if not fIsRad then result.re := cos(DegToRad(Expr(ExprError).re))
        else result.re := cos(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'tg' then
    begin
     Lexeme := fSeq[fPos];
     inc(fPos);
     if not fIsRad then result.re := tan(DegToRad(Expr(ExprError).re))
       else result.re := tan(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
     exit;
    end;
    if Lexeme.S = 'ctg' then
    begin
      Lexeme := fSeq[fPos];
     inc(fPos);
      if not fIsRad then result.re := cotan(DegToRad(Expr(ExprError).re))
        else result.re := cotan(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'arcsin' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      if not fIsRad then result.re := RadToDeg(arcsin(Expr(ExprError).re))
       else result.re := arcsin(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'arccos' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      if not fIsRad then result.re := RadToDeg(arccos(Expr(ExprError).re))
        else result.re := arccos(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'arctg' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      if not fIsRad then result.re := RadToDeg(arctan(Expr(ExprError).re))
        else result.re := arctan(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'exp' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      result.re := exp(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'ln' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      result.re := ln(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'sqr' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      result.re := sqr(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'sqrt' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      result.re := sqrt(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'abs' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      result.re := abs(Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'pow' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      FirstArg := Expr(ExprError).re;
      if ExprError.Reason <> errNone then
      begin
        Error := ExprError;
        exit;
      end;
      result.re := Power(FirstArg, Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'SQRn' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      FirstArg := Expr(ExprError).re;
      if ExprError.Reason <> errNone then
      begin
        Error := ExprError;
        exit;
      end;
      result.re := power(FirstArg, 1/Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'log' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      FirstArg := Expr(ExprError).re;
      if ExprError.Reason <> errNone then
      begin
        Error := ExprError;
        exit;
      end;
      result.re := LogN(FirstArg, Expr(ExprError).re);
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end;
    if Lexeme.S = 'fact' then
    begin
      Lexeme := fSeq[fPos];
      inc(fPos);
      FirstArg := Expr(ExprError).re;
      if pos(DecimalSeparator, FloatToStr(FirstArg)) <> 0 then
      begin
        Error.Reason := errNoInt;
        Error.Pos := fPos;
        exit;
      end;
      if Round(FirstArg) > 20 then
      begin
        Error.Reason := errAryphm;
        Error.Pos := fPos;
        exit;
      end;
      result.re := factorial(Round(FirstArg));
      if ExprError.Reason <> errNone then Error := ExprError;
      exit;
    end
      else
        Error.Reason := errIdent;
  except
    Error.Reason := errAryphm;
    Error.Pos := fPos;
  end;
end;

procedure TSyntaxAnalyser.SeIsRadians(const Value: boolean);
begin
  fIsRad := Value;
end;

function TSyntaxAnalyser.Term(var Error: TErr): TComplex;
var
  FacTError: TErr;
  DivZero: boolean;
begin
  DivZero := false;
  FactError.Reason := errNone;
  result := Factor(FactError);
  if FactError.Reason <> errNone then
  begin
    Error := FactError;
    exit;
  end;
  while (fPos <= High(fSeq)) and (Lexeme.LexType = ltOp2) do
  case Lexeme.C of
    '*': result := Mult(result, Factor(FactError));
    '/':
    begin
      result := Divide(result, Factor(FactError), DivZero);
      if DivZero then
      begin
        error.Reason := errDivZero;
        exit;
      end;
    end;
  end;
end;

{ TCalculator }

procedure TCalculator.SetIsRad(const AValue: boolean);
begin
  fIsRad := AValue;
end;

procedure TCalculator.SetLogFileName(const AValue: KOLString);
begin
  fLogFileNAme := AValue;
end;

procedure TCalculator.FormLog(Strings: TStringList);
var
  i: integer;
begin
  for i := 0 to High(fLexSeq) do
    case fLexSeq[i].LexType of
      ltNum: Strings.Add('number = ' + compltostr(fLexSeq[i].D) +
        ' StartPos = ' + IntToStr(fLexSeq[i].StartPos) + ' Endpos = ' + IntToStr(fLexSeq[i].EndPos));
      ltVar: Strings.Add('variable = ' + fLexSeq[i].V.fName + 'count = ' + IntToStr(fLexSeq[i].V.fCount) +
        ' StartPos = ' + IntToStr(fLexSeq[i].StartPos) + ' Endpos = ' + IntToStr(fLexSeq[i].EndPos));
      ltID: Strings.Add('ID = ' + fLexSeq[i].S + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' Endpos = ' + IntToStr(fLexSeq[i].EndPos));
      ltSep: Strings.Add('Float sep = ' + fLexSeq[i].C + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' Endpos = ' + IntToStr(fLexSeq[i].EndPos));
      ltLBr, ltRBr: Strings.Add('Bracket = ' + fLexSeq[i].C + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' Endpos = ' + IntToStr(fLexSeq[i].EndPos));
      ltASep: Strings.Add('ArgSep = ' + fLexSeq[i].C + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' EndPos = ' + IntToStr(fLexSeq[i].EndPos));
      ltOp1, ltOp2: Strings.Add('Operator = ' + fLexSeq[i].C + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' EndPos = ' + IntToStr(fLexSeq[i].EndPos));
      ltUnOp: Strings.Add('Unary operator = ' + fLexSeq[i].C + ' StartPos = ' + IntToStr(fLexSeq[i].StartPos)
        + ' EndPos = ' + IntToStr(fLexSeq[i].EndPos));
    end;
end;

procedure TCalculator.SetIsExpMode(const AValue: boolean);
begin
  fIsExpMode := AValue;
end;

procedure TCalculator.SetIsLog(const AValue: boolean);
begin
  fIsLog := AValue;
end;

constructor TCalculator.Create(const Str: KOLString);
begin
  Error.Reason := errNone;
  ErrorHappens := false;
  fStr := Str;
  fIsRad := false;
end;

function TCalculator.GetLastError: KOLString;
begin
  case Error.Reason of
    errEnd: Result := 'Неожиданный конец выражения';
    errIdent: Result := 'Неизвестная функция';
    errIllegal: Result := 'Неверный символ в позиции '+ IntToStr(Error.Pos);
    errBracket: Result := 'Не хватает скобки в позиции ' + IntToStr(Error.Pos);
    errExpr: Result := 'Неверное выражение';
    errAryphm: Result := 'Невычислимое выражение';
    errDivZero: Result := 'Деление на ноль';
    errNoInt: Result := 'Функция требует целый аргумент';
  end;
end;

procedure TCalculator.OnlyAnalyse;
begin
  fLexAn := TLexAnalyser.Create(fStr);
  fLexAn.IsExpMode := fIsExpMode;
  fLexAn.IsRad := fIsRad;
  Error := fLexAn.Analyse(fLexSeq);
  if Error.Reason <> errNone then
  begin
    FreeAndNil(fLexAn);
  end else
  begin
    FreeAndNil(fLexAn);
  end;
end;

function TCalculator.CalcWithoutVars: TComplex;
var
  StringList: TStringList;
begin
  if fIsLog then
  begin
    StringList := TStringList.Create;
    if FileExists(fLogFileName) then StringList.LoadFromFile(fLogFileName);
  end;
  Error.Reason := errNone;
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    if fIsLog then
    begin
      StringList.Add(DateToStr(Now) + ' ' + TimeToStr(Now));
      StringList.Add('Start parsing');
      StringList.Add('String = ' + fStr);
    end;
    Error := fLexAn.Analyse(fLexSeq);
    if fIsLog then FormLog(StringList);
    if Error.Reason <> errNone then
    begin
      if fIsLog then
      begin
        StringList.Add('LexAnalyse = error');
        StringList.Add(GetLastError);
        StringList.SaveToFile(fLogFileName);
        FreeAndNil(StringList);
      end;
      ErrorHappens := true;
      exit;
    end;
    if fIsLog then StringList.Add('LexAnalyse = OK');
  finally
    FreeAndNil(fLexAn);
  end;
  if fIsLog then StringList.Add('Start calculating');
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.IsRadians := fIsRad;
    result := fSynAn.calc(Error);
  finally
    if Error.Reason <> errNone then
    begin
      ErrorHappens := true;
      if fIsLog then
      begin
        StringList.Add('Calculating = error');
        StringList.Add(GetLastError);
        StringList.SaveToFile(fLogFileName);
        FreeAndNil(StringList);
      end;
    end else
    if fIsLog then
    begin
      StringList.Add('Calculating = OK');
      StringList.SaveToFile(fLogFileName);
      FreeAndNil(StringList);
    end;
    FreeAndNil(fSynAn);
  end;
end;

function TCalculator.SingleVarCalc(const Variable: TComplex): TComplex;
var
  VarArr: TComplexArr;
begin
  Error.Reason := errNone;
  SetLength(VarArr, 1);
  VarArr[0] := Variable;
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    Error := fLexAn.Analyse(fLexSeq);
  finally
    FreeAndNil(fLexAn);
    if Error.Reason <> errNone then ErrorHappens := true;
  end;
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.Variable := VarArr;
    fSynAn.IsRadians := fIsRad;
    result := fSynAn.calc(Error);
  finally
    FreeAndNil(fSynAn);
    if Error.Reason <> errNone then ErrorHappens := true;
  end;
end;

function TCalculator.SingleVarIteration(const From: extended;
  const ToDo: extended; const Step: extended): TComplexMatrix;
var ArgCount: integer;
    i: integer;
    Value: TComplexArr;
    Num: Extended;
begin
  error.Reason := errNone;
  ArgCount := round((todo - from)/step);
  SetLength(result, ArgCount + 1, 2);
  SetLength(Value, 1);
  Value[0].re := From;
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    Error := fLexAn.Analyse(fLexSeq);
  finally
    FreeAndNil(fLexAn);
    if Error.Reason <> errNone then ErrorHappens := true;
  end;
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.IsRadians := fIsRad;
    i := 0;
    while i <= High(Result) do
    begin
      Error.Reason := errNone;
      fSynAn.Variable := Value;
      Num := fSynAn.calc(Error).re;
      if Error.Reason <> errNone then
      begin
        SetLength(Result, Length(result)-1, 2);
        Value[0].re := Value[0].re + Step;
        Continue;
      end;
      result[i,0].re := Value[0].re;
      result[i,1].re := Num;
      inc(i);
      Value[0].re := Value[0].re + Step;
    end;
  finally
    FreeAndNil(fSynAn);
  end;
end;

function TCalculator.FormGraphMatrix(const From: extended;
  const ToDo: extended; const Step: extended; const Constraint: extended
  ): TFloatMatrix;
var ArgCount: integer;
    i: integer;
    Value: TComplexArr;
    Num: Extended;
begin
  error.Reason := errNone;
  ArgCount := round((todo - from)/step);
  SetLength(result, ArgCount + 1, 2);
  SetLength(Value, 1);
  Value[0].re := From;
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    Error := fLexAn.Analyse(fLexSeq);
  finally
    FreeAndNil(fLexAn);
    if Error.Reason <> errNone then ErrorHappens := true;
  end;
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.IsRadians := fIsRad;
    i := 0;
    while i <= High(Result) do
    begin
      Error.Reason := errNone;
      fSynAn.Variable := Value;
      Num := fSynAn.calc(Error).re;
      if (Error.Reason <> errNone) or (abs(Num) > constraint) then
      begin
        SetLength(Result, Length(result)-1, 2);
        Value[0].re := Value[0].re + Step;
        Continue;
      end;
      result[i,0] := Value[0].re;
      result[i,1] := Num;
      inc(i);
      Value[0].re := Value[0].re + Step;
    end;
  finally
    FreeAndNil(fSynAn);
  end;
end;

function TCalculator.MultiVarCalc(const VarArray: TComplexArr): TComplex;
var
  Err: TErr;
begin
  err.Reason := errNone;
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    fLexAn.Analyse(fLexSeq);
  finally
    FreeAndNil(fLexAn);
  end;
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.Variable := VarArray;
    fSynAn.IsRadians := fIsRad;
    result := fSynAn.calc(Err);
  finally
    FreeAndNil(fSynAn);
  end;
end;

function TCalculator.GetValuesFromArguments(const Arguments: TVector): TVector;
var
  i: integer;
  Value: TComplexArr;
begin
  SetLength(Result, Length(Arguments));
  fLexAn := TLexAnalyser.Create(fStr);
  try
    fLexAn.IsExpMode := fIsExpMode;
    fLexAn.IsRad := fIsRad;
    Error := fLexAn.Analyse(fLexSeq);
  finally
    FreeAndNil(fLexAn);
    if Error.Reason <> errNone then ErrorHappens := true;
  end;
  fSynAn := TSyntaxAnalyser.Create(fLexSeq);
  try
    fSynAn.IsRadians := fIsRad;
    Setlength(Value, 1);
    for i := 0 to high(Result) do
    begin
      Value[0].re := Arguments[i];
      Error.Reason := errNone;
      fSynAn.Variable := Value;
      Result[i] := fSynAn.calc(Error).re;
    end;
  finally
    FreeAndNil(fSynAn);
  end;
end;

end.
